Developer CD Series 2000 August: Tool Chest/Dev.CD Aug 00 TC Disk 2.toast/pc/sample code/human interface toolbox/colorcdef/sampctrl.p

Text File | 2000-06-23 | 15.1 KB | 495 lines

{
    File:        SampCtrl.p

    Contains:    This working sample defproc emulates the features of the standard button control for
                system software 7.0 on the macintosh. This defproc, while completely functional is
                intended as an explanatory example to show some of the basics of writing your own
                defproc.

                Items not implemented:
                • Multiple line titles
                • Checking to be sure I am running under system 7.0


    Written by:

    Copyright:    Copyright © 1991-1999 by Apple Computer, Inc., All Rights Reserved.

                You may incorporate this Apple sample source code into your program(s) without
                restriction. This Apple sample source code has been provided "AS IS" and the
                responsibility for its operation is yours. You are not permitted to redistribute
                this Apple sample source code as "Apple sample source code" after having made
                changes. If you're going to re-distribute the source, we require that you make
                it clear in the source that the code was descended from Apple sample source
                code, but that you've made changes.

    Change History (most recent first):
                7/19/1999    Karl Groethe    Updated for Metrowerks Codewarror Pro 2.1
                6/3/91        Mensch    Finished adding comments and cleaning up some bugs. could be 1.0
                5/28/91        Mensch    Created this whole thing
}
UNIT SampCtrl;

Interface
  USES     Memory, quickdraw, Controls,Windows,GestaltEqu;

Function MySampControl(    VarCode:Integer; theControl:ControlHandle;
                        Message:Integer; param:LongInt) : LongInt;

Implementation
{     The following hack is needed because The entry for the defproc needs to be the first
    executable code, and MPW places sub procedures before main procedures.}

{ see tech note 256 for the discussion of the QDVarRec information here }
Type    QDVarRecPtr = ^QDVarRec;
        QDVarRec = Record
                    randSeed:Longint;
                    screenBits:Bitmap;
                    arrow:cursor;
                    dkGray:pattern;
                    ltGray:pattern;
                    gray:pattern;
                    black:pattern;
                    white:pattern;
                    thePort:Grafptr;
                   end;

Function YouMustBeJoking (a:Integer; b:ControlHandle; c:Integer; d:LongInt):LongInt;

begin
    YouMustBeJoking:=MySampControl(a,b,c,d);
end;

{
    FUNCTION xGestalt(selector: OSType;VAR response: LONGINT): OSErr;
    Inline $202F,$0004,$A1AD,$2257,$2288,$3f40,$0008,$508F;

            Move.L Selector(sp),D0
            _Gestalt
            Move.L    response(sp),A1
            Move.L    A0,(A1)
            Move.W    D0,xGestalt(sp)
            AddQ.L    #$8,sp
}
Procedure GetMyQDVarRec(var a:qdVarRec);
begin
    a:=QDVarRecPtr(LongintPtr(SetCurrentA5)^-(SizeOf(QDVarRec)-SizeOf(qd.thePort)))^;
end;

Function MySampControl(    VarCode:Integer; theControl:ControlHandle;
                        Message:Integer; param:LongInt) : LongInt;


type    CDPInfo= packed array[0..3] of byte;

Var
{ Globals used throughout the sample control go here }
        theResult : Longint;        { set by individual functions/ returned by defproc }
        ResultValid : Boolean;        { If true return theResult else return 0 }

        HasColorQD : Boolean;

        oldState : PenState;        { The following are for storing the state of the grafport }
        oldTextMode,oldTextSize,oldTextFont : Integer;
        oldClipRgn    : rgnHandle;
        oldForeColor,oldBackColor : RGBColor;

        theColorTab: CCTabHandle;    { Color table to use to draw the control }
        wContRGB    : RGBColor;        { the windows content color }

        { Use these to suck information from the control record for ease of use }
        IsSimpleButton,isCheckBox,IsRadioBut:Boolean;
        thisCDPInfo    : cdpInfo;
        thisHiLite    : Integer;    { set to hilite value of the control }
        thisWindow    : windowPtr;

        QD            : qdVarRec;    { our current quickdraw "globals" }

    Procedure StdDrawSetup;
    { This routine preforms any standard setup that is required by the drawing functions }

    var    tempInt:integer;
        tempLong:Longint;
        anErr:OSErr;
        aAuxWin:AuxWinHandle;
        aCTab:CTabHandle;
        theAuxData : AuxCtlHandle;
        FMDefSizePtr:Ptr;
        SysFontSize:IntegerPtr;

    begin
        GetPenState(oldState);
        PenNormal;
        GetMyQDVarRec(QD);
        oldTextSize:=thisWindow^.txSize;
        oldTextFont:=thisWindow^.txFont;
        TextFont(0);                    { This is how we do it, you could set any font/size }
        SysFontSize:=IntegerPtr($BA8);    { that you want }
        FMDefSizePtr:=ptr($987);
        if SysFontSize^<>0 then
          TextSize(SysFontSize^)
        else
          TextSize(Integer(FMDefSizePtr^));

        HasColorQD:=false;
        anErr:=Gestalt(GestaltQuickdrawVersion,tempLong);
        if (anErr=0) and (tempLong>=gestalt8BitQD) then HasColorQD:=true;
        if HasColorQD then
          begin
            oldTextMode:=thisWindow^.txMode;
            GetForeColor(oldForeColor);
            GetBackColor(oldBackColor);
            if GetAuxiliaryControlRecord(theControl,theAuxData) then ; {result unimportant}
            theColorTab:=theAuxData^^.acCTable;
            if GetAuxWin(thisWindow,aAuxWin) then ;{result unimportant}
            aCTab:=aAuxWin^^.awCTable;
            tempInt:=aCTab^^.ctSize;
            while tempInt>=0 do
              begin
                wContRGB:=aCTab^^.ctTable[tempInt].rgb;
                if aCTab^^.ctTable[tempInt].value=wContentColor then tempInt:=0;
                tempInt:=tempInt-1;
              end
          end;
    end;

    Procedure StdDrawTearDown;

    begin
        if HasColorQD then
          begin
            RGBForeColor(oldForeColor);
            RGBBackColor(oldBackColor);
            TextMode(oldTextMode);
          end;
        TextFont(oldTextFont);
        TextSize(oldTextSize);
        SetPenState(oldState);
    end;

    function RoundFactor:Integer;
 {this procedure calculates the rounding factor for the simple button that we are
  drawing. It emulates what the standard control does }

    var        tempInt:integer;

      begin
        if isSimpleButton then    {only simple buttone are rounded}
          begin
              tempInt:=theControl^^.ContrlRect.Bottom-theControl^^.contrlRect.Top;
            RoundFactor:=tempInt div 2;
          end
        else RoundFactor:=0;    { check boxes and radio buttons get no rounding }
    end;

    Procedure DoTestCntl;

    begin
        { This routine is called in response to the testCtrl message it simply returns
          the proper part code if the mouse is in the current control rect. }
        if thisHiLite<255 then    { hit test is only valid if the control is enabled }
          begin
{preflight the part code of the result for now..}
            if isCheckBox then
                theResult:=kControlCheckBoxPart
            else
              theResult:=kControlButtonPart;
            ResultValid:=PtInRect(Point(param),TheControl^^.ContrlRect);
          end;
    end;

    Procedure DoCalcCRegions;

    type    patPtr=^pattern;

    var        tempInt:Integer;
            thePatPtr:PatPtr;

    begin
        { Called in response to all region calculation routines. This simply sets the passed
          region to the bounding region of the control }
        if not(isSimpleButton) then
            RectRgn(rgnHandle(param),theControl^^.ContrlRect)
        else
          begin
            GetPenState(oldState);
            penNormal;
            hidePen;
            OpenRgn;
            tempInt:=RoundFactor;
            FrameRoundRect(theControl^^.ContrlRect,tempInt,tempInt);
            CloseRgn(rgnHandle(param));
            SetPenState(oldState);
          end;
 {Set the control manager pattern for control dragging. This is a good place to do this
  in case it was screwed up by some other routine. This is done because we do not have our
  own pos proc...}
          thePatPtr:=patPtr($A34);
          thePatPtr^:=QD.gray;
    end;


    procedure DoDrawIt;

    var    roundNess:Integer;
        isDisabled,isHiLited,isNormal:Boolean;
        tempInt:Integer;
        boxWidth:Integer;
        lineHeight:Integer;
        textRect,ctlRect,outerRect:Rect;
        theInfo:FontInfo;
        useGrayText:Boolean;
        aColor:RGBColor;

        {Called in response to the DrawCtrl message, this code draws the control in its proper
         state in its proper colors (as defined in the controls color table. the values in the
         table below refer to the control color table value type).
         The proper colors for color controls are as follows (radio & checkboxes are the same):

         type/State:        Frame            Text        Background
         CheckBox/normal    cFrameColor        cTextColor    window content color
         CheckBox/Hilited    cFrameColor        cTextColor    window content color
         CheckBox/Disabled    cFrameColor        cTextColor    window content color
         SimpleBut/normal    cFrameColor        cTextColor    cBodyColor
         SimpleBut/HiLited    cFrameColor        cBodyColor    cTextColor
         SimpleBut/Disabled    cFrameColor        cTextColor    cBodyColor

         For disabled items, if drawing into a cGrafport then textmode is set to GrayishTextOr,
         otherwise we use the old style overstrike with gray pattern in mode BIC.}


        procedure GetCtlColor(theValue:integer; VAR theRGB:RGBColor);

        var    anInt:integer;

        begin
            {Given theValue as the part code to get the color for, this routine returns its
             RGB value. If no color is assigned to the part code, the first color entry is
             returned. This technique can also be used to look up values in window color tables}

            anInt:=theColorTab^^.ctSize;
            while anInt>=0 do
              begin
                theRGB:=theColorTab^^.ctTable[anInt].rgb;
                if theColorTab^^.ctTable[anInt].value=theValue then anInt:=0;
                anInt:=anInt-1;
              end
        end;

          procedure CalcBackColor;

        begin
            {based on the state/status of the control, set the background}
            aColor:=wContRGB;        { Background color for radio/check boxes }
            if isSimpleButton then
              begin
                if isHiLited then GetCtlColor(cTextColor,aColor)
                else GetCtlColor(cBodyColor,aColor);
              end;
            If hasColorQD then RGBBackColor(aColor);
        end;

          procedure CalcForeColor;

        begin
            {based on the state/status of the control, set the foreground}
            if (isHiLited and  isSimpleButton) then GetCtlColor(cBodyColor,aColor)
            else GetCtlColor(cTextColor,aColor);
            If hasColorQD then RGBForeColor(aColor);
        end;

        procedure CalcFrameColor;

        begin
            {based on the state/status of the control, set the frame(foreground)}
            GetCtlColor(cFrameColor,aColor);
            If hasColorQD then RGBForeColor(aColor);
        end;

        procedure CalcTextColor;

        begin
            { Set the useGrayText variable if we are ising color quickdraw and the control
              owner is a cGrafPort thisWindow^.PortBits.rowBytes is also thisWindow^.portVersion}
            useGrayText:=false;
            if HasColorQD then
              begin
                useGrayText:=(BAND(thisWindow^.PortBits.rowBytes,$C000)<>0);
                if useGrayText and isDisabled then TextMode(GrayishTextOr);
                CalcForeColor;
              end;
        end;

        procedure DrawTheTitle;

        begin
            { find out how big the title is and center it in the control rectangle and draw the
              it. this is NOT how the standard control does it.}
            LineHeight:=theInfo.ascent+theInfo.Descent;
            tempInt:=textRect.bottom-textRect.top;
            if lineHeight<tempInt then
              begin
                textRect.top:=textRect.top+((tempInt-lineHeight) div 2);
                textRect.Bottom:=textRect.top+LineHeight;
              end;
            if isSimpleButton then
              begin
                tempInt:=StringWidth(theControl^^.contrlTitle);
                boxWidth:=textRect.right-textRect.left;
                if tempInt<boxWidth then
                  begin
                    TextRect.Left:=TextRect.left+((boxWidth-tempInt) div 2);
                  end
                else
                  TextRect.Left:=TextRect.Left;
              end
            else
              textRect.Left:=textRect.Left+18;
            textRect.Right:=textRect.left+stringWidth(theControl^^.contrlTitle);
            MoveTo(textRect.left,textRect.top+theInfo.ascent);
            DrawString(theControl^^.contrlTitle);
        end;

        function ShrinkClip:boolean;
        { Set the clip rgn of the grafport to be the intersection of the current clip rgn
          and the control rectangle. This will insure that we never draw outside of out control
          Return true if this results in an empty region. so that drawing does not take place }
        var    Wally:boolean;

        begin
            oldClipRgn:=NewRgn;
            GetClip(oldClipRgn);    {copy the current clip region}
            ClipRect(theControl^^.ContrlRect);
            SectRgn(oldClipRgn,ThisWIndow^.ClipRgn,ThisWIndow^.clipRgn);
            Wally:=EmptyRgn(ThisWindow^.ClipRgn);
            if Wally then
              begin
                SetClip(oldClipRgn);
                DisposeRgn(oldClipRgn);
              end;
            ShrinkClip:=Wally;
        end;

        procedure DrawIndBox;

        begin
            {Draws the check box or little round radio button and fills it in. NOTE: the filled
             in indicator is drawn in the frame color. With system 7, the indicator is never dimmed
             and it is the only portion of the control that indicated a hilighted item CalcFrameColor
             was called before this routine is called.}
          CalcBackColor;
          EraseRect(OuterRect);
          if isHiLited then pensize(2,2);
          if isCheckBox then FrameRect(OuterRect)
          else FrameOval(outerRect);
          penSize(1,1);
          if theControl^^.contrlValue=0 then exit(DrawIndBox); {If value 0 then don't fill in indicator}
          if isRadioBut then
            begin
              insetRect(outerRect,3,3);
              PaintOval(outerRect);
            end
          else
            begin
              InsetRect(outerRect,1,1);
              MoveTo(outerRect.left,outerRect.top);
              LineTo(outerRect.right,outerRect.Bottom);
              MoveTo(outerRect.right,outerRect.top-1);
              Lineto(outerRect.left-1,outerRect.Bottom);
            end;
        end;

        Procedure DisableButton;

        begin
            { if the useGrayText indicates that we have not already drawn the text in a
              light gray fashion, then do the old style dimming on it.}
            if UseGrayText then Exit(DisableButton);
            if isSimpleButton then
              begin
                CalcForeColor;
                CalcBackColor;
              end;
            InsetRect(CtlRect,1,1);
            PenPat(QD.gray);
            PenMode(patBIC);
            if isSimpleButton then
               PaintRoundRect(ctlRect,roundNess,roundNess)
            else
               PaintRect(textRect);
        end;

    begin
        if theControl^^.ContrlVis<>255 then exit(DoDrawIt); {no drawing needed for invisible controls}
    { Set up some drawing variables that are used often for drawing }
        ctlRect:=theControl^^.ContrlRect;
        isDisabled:=(thisHiLite=255);
        isNormal:=(thisHiLite=0);
        isHiLited:=not(isDisabled or isNormal);

        if ShrinkClip then exit(DoDrawIt);
        StdDrawSetup;
        roundNess:=roundFactor;
        { Erase the control bounding box }
        if HasColorQD then CalcBackColor;
        { if param=0 then }
          EraseRoundRect(ctlRect,roundNess,roundNess);
        outerRect:=ctlRect;
        textRect:=outerRect;
        if not(isSimpleButton) then
          begin
              tempInt:=(outerRect.bottom-OuterRect.top-12) div 2;
            outerRect.Top:=outerRect.top+tempInt;
            outerRect.Bottom:=outerRect.top+12;
            outerRect.right:=outerRect.Left+12;
          end;
        CalcTextColor;
        GetFontInfo(theInfo);
        DrawtheTitle;
        CalcFrameColor;
        if IsSimpleButton then
            FrameRoundRect(theControl^^.contrlRect,roundNess,roundNess)
        else  DrawindBox;
        if isDisabled then DisableButton;
        { if we are on a black and white machine the button has yet to be inverted if
          it is selected.}
        if Not(HasColorQD) and isHiLited then
          InvertRoundRect(ctlRect,roundNess,roundNess);
        SetClip(oldClipRgn);
        DisposeRgn(oldClipRgn);
        StdDrawTearDown;
    end;

Begin
    theResult:=0;
    ResultValid:=false;
    thisCDPInfo:=cdpInfo(theControl^^.ContrlDefProc);
    thisWindow:=theControl^^.contrlOwner;
    thisHiLite:=theControl^^.ContrlHiLite;
    isSimpleButton:= thisCDPInfo[0]=0;
    isCheckBox:= thisCDPInfo[0]=1;
    isRadioBut:= thisCDPInfo[0]=2;
    Case Message of
        drawCntl    : DoDrawIt;
        testCntl    : DoTestCntl;
        calcCRgns    : DoCalcCRegions;
        initCntl     : ;        { can be used to initialize special control data structures }
        dispCntl    : ;        { If you need to clean up anything before you finish }
        posCntl     : ;        { If you don't want standard control mgr moveing }
        thumbCntl     : ;        { for use with custom thumb dragging routines }
        dragCntl     : ;        { for custom dragging of the control, or parts of }
        autoTrack     : ;        { a default track control function for all controls of this type }
        calcCntlRgn,
        calcThumbRgn: begin
                           ResultValid:=true;
                        theResult:=1;
                        DoCalcCRegions;
                      end;
      Otherwise ;
    end; {Case}
    If ResultValid then MySampControl:=theResult
      else MySampControl:=0;
End;

End.